unit apphelpers;

interface

uses VirtualTrees, VirtualTrees.Types, main, Winapi.Windows, Vcl.Graphics,
  System.SysUtils, System.JSON, REST.JSON, Redis.Values;
procedure FixVT(VT: TVirtualStringTree; MultiLineCount: Word = 1);
function GetTextHeight(Font: TFont): Integer;
function RespArrayToJsonObject(lRes: TRedisRESPArray): TJSONObject;

implementation

function GetTextHeight(Font: TFont): Integer;
var
  DC: HDC;
  SaveFont: HFont;
  SysMetrics, Metrics: TTextMetric;
begin
  // Code taken from StdCtrls.TCustomEdit.AdjustHeight
  DC := GetDC(0);
  GetTextMetrics(DC, SysMetrics);
  SaveFont := SelectObject(DC, Font.Handle);
  GetTextMetrics(DC, Metrics);
  SelectObject(DC, SaveFont);
  ReleaseDC(0, DC);
  Result := Metrics.tmHeight;
end;

function RespArrayToJsonObject(lRes: TRedisRESPArray): TJSONObject;
var
  key, value: string;
  Index: Integer;
  jobj: TJSONObject;
begin
  if Assigned(lRes) then
  begin
    jobj := TJSONObject.Create;
    try
      for Index := 0 to lRes.Count - 1 do
      begin
        if not Index mod 2 = 0 then
        begin
          jobj.AddPair(key, lRes.Items[Index].value);
        end
        else
        begin
          key := lRes.Items[Index].value;
        end;

      end;
    finally

    end;
    Result := jobj;
  end;

end;

procedure FixVT(VT: TVirtualStringTree; MultiLineCount: Word = 1);
var
  SingleLineHeight: Integer;
  Node: PVirtualNode;
begin
  // This is called either in some early stage, or from preferences dialog
  VT.BeginUpdate;
  SingleLineHeight := GetTextHeight(VT.Font) + 7;
  // Multiline nodes?
  VT.DefaultNodeHeight := SingleLineHeight * MultiLineCount;
  VT.Header.Height := SingleLineHeight;
  // Apply new height to multi line grid nodes
  Node := VT.GetFirstInitialized;
  while Assigned(Node) do
  begin
    VT.NodeHeight[Node] := VT.DefaultNodeHeight;
    VT.MultiLine[Node] := MultiLineCount > 1;
    Node := VT.GetNextInitialized(Node);
  end;
  VT.EndUpdate;
  // Disable hottracking in non-Vista mode, looks ugly in XP, but nice in Vista
  if ((toUseExplorerTheme in VT.TreeOptions.PaintOptions) and
    (Win32MajorVersion >= 6)) then
    VT.TreeOptions.PaintOptions := VT.TreeOptions.PaintOptions + [toHotTrack]
  else
    VT.TreeOptions.PaintOptions := VT.TreeOptions.PaintOptions - [toHotTrack];
  // VT.OnGetHint := MainForm.AnyGridGetHint;
  // VT.OnScroll := MainForm.AnyGridScroll;
  // VT.OnMouseWheel := MainForm.AnyGridMouseWheel;
  VT.ShowHint := True;

  if toGridExtensions in VT.TreeOptions.MiscOptions then
    VT.HintMode := hmHint
    // Show cell contents with linebreakds in datagrid and querygrid's
  else
    VT.HintMode := hmTooltip; // Just a quick tooltip for clipped nodes
  // Apply case insensitive incremental search event
  // if VT.IncrementalSearch <> VirtualTrees.Types.isNone then
  // VT.OnIncrementalSearch := MainForm.AnyGridIncrementalSearch;
  // VT.OnStartOperation := MainForm.AnyGridStartOperation;
  // VT.OnEndOperation := MainForm.AnyGridEndOperation;
end;

end.
